(load "Base.scm")
(load "Pair.scm")
(load "Table.scm")
(load "Utils.scm")

;; now lets start

;; defining the type of action

(define atom-to-action
  (lambda (e)
    (cond
      ((number? e) *const)
      ((bool? e) *const)
      ((eq? e 'cons) *const)
      ((eq? e 'car) *const)
      ((eq? e 'cdr) *const)
      ((eq? e 'null?) *const)
      ((eq? e 'eq?) *const)
      ((eq? e 'atom?) *const)
      ((eq? e 'add1) *const)
      ((eq? e 'sub1) *const)
      ((eq? e 'number?) *const)
      ((eq? e 'bool?) *const)
      ((eq? e 'id) *const)
      (else *identifier))))

(define list-to-action
  (lambda (e)
    (cond
      ((atom? (car e)) 
        (cond
          ((eq? (car e) 'quote) *quote)
          ((eq? (car e) 'lambda) *lambda)
          ((eq? (car e) 'cond) *cond)
          (else *application)))
      (else *application))))

(define expression-to-action
  (lambda (e)
    (cond
      ((atom? e) (atom-to-action e))
      (else (list-to-action e)))))

;; do the action

(define value
  (lambda (e)
    (meaning e '()))) ;; here '() is the initial var-value table

(define meaning
  (lambda (e table)
    ((expression-to-action e) e table)))

;; for each specific action: what should be done

;; const

(define *const
  (lambda (e table)
    (cond
      ((number? e) e)
      ((bool? e) e)
      (else (build 'primitive e)))))

;; quote

(define *quote
  (lambda (e table) 
    (text-of e)))

(define text-of second)

;; identifier

(define *identifier
  (lambda (e table)
    (lookup-in-table e table initial-table)))

(define initial-table
  (lambda (name) 
    ("Error (in *identifier): unrecognized const or identifier")))

;; lambda: see the textbook

(define *lambda
  (lambda (e table)
    (build 'non-primitive (cons table (cdr e)))))

(define table-of first)
(define formals-of second)
(define body-of third)

;; cond

(define *cond
  (lambda (e table)
    (evcon (cond-lines-of e) table)))

(define cond-lines-of cdr)

(define evcon
  (lambda (lines table)
    (cond
      ((else? (question-of (car lines)))
        (meaning (answer-of (car lines)) table))
      ((meaning (question-of (car lines)) table)
        (meaning (answer-of (car lines)) table))
      (else (evcon (cdr lines) table)))))


(define else?
  (lambda (x)
    (cond
      ((atom? x) (eq? x 'else))
      (else #f))))

(define question-of first)
(define answer-of second)

;; application

(define *application
  (lambda (e table)
    (apply 
      (meaning (function-of e) table)
      (evlis (arguments-of e) table))))

(define function-of car)
(define arguments-of cdr)

(define evlis
  (lambda (args table)
    (map 
      (lambda (arg) (meaning arg table))
      args)))

;; apply in *application

(define apply
  (lambda (fun vals)
    (cond
      ((primitive? fun)
        (apply-primitive (second fun) vals))
      ((non-primitive? fun)
        (apply-closure (second fun) vals))
      (else "Error (in apply): unrecognized primitive type (not primitive or non-primitive)"))))

(define primitive?
  (lambda (l)
    (eq? (first l) 'primitive)))

(define non-primitive?
  (lambda (l)
    (eq? (first l) 'non-primitive)))

;; apply-p/apply-c in apply

(define apply-primitive
  (lambda (name vals)
    (cond
      ((eq? name 'cons) (cons (first vals) (second vals)))
      ((eq? name 'car) (car (first vals)))
      ((eq? name 'cdr) (cdr (first vals)))
      ((eq? name 'null?) (null? (first vals)))
      ((eq? name 'eq?) (eq? (first vals) (second vals)))
      ((eq? name 'atom?) (atom? (first vals)))
      ((eq? name 'add1) (add1 (first vals)))
      ((eq? name 'sub1) (sub1 (first vals)))
      ((eq? name 'number?) (number? (first vals)))
      ((eq? name 'bool?) (bool? (first vals)))
      ((eq? name 'id) (id (first vals)))
      (else "Error (in apply-primitive): unrecognized primitive function"))))

(define apply-closure
  (lambda (closure vals)
    (meaning
      (body-of closure)
      (extend-table
        (new-entry (formals-of closure) vals)
        (table-of closure)))))

;; tests

(define test
  (list
    '(lambda (x) (add1 (add1 x)))
    '(cond
      ((bool? #t) 2)
      (else 3))))